home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2002 #11 / Amiga Plus CD - 2002 - No. 11.iso / Tools / ShareMailGiftware / AmigaTalk / system / AmigaGuide.st next >
Text File  |  2002-10-27  |  12KB  |  330 lines
  1. " ------------------------------------------------------------------------- "
  2. " AmigaGuide Class implements the Amigatalk interface to amigaguide.library "
  3. " This Class is only one step removed from primitives, so use it to derive  "
  4. " a Class that is really Object-Oriented! "
  5. " ------------------------------------------------------------------------- "
  6.  
  7. Class AmigaGuide :Object ! private private2 private3 !
  8. [
  9.    addAmigaGuideHost: hostNameString hook: hookObj tags: tagArray
  10.      " Returns nil if unable to add the AmigaGuide Host named: "
  11.      private2 <- <primitive 209 2 2 hookObj hostNameString tagArray>
  12. |
  13.    removeAmigaGuideHost: tagArray " tagArray should be nil for now. "
  14.      (private2 isNotNil)
  15.         ifTrue: [^ <primitive 209 2 3 private2 tagArray>]
  16. |
  17.    getAmigaGuideSignal
  18.      ^ <primitive 209 2 4 private>
  19. |
  20.    closeAmigaGuide
  21.      <primitive 209 2 0 private>.
  22.  
  23.      ^ private <- nil
  24. |
  25.    getAmigaGuideAttribute: attrTag into: storageObj
  26.      " For attrTag, see AGuideTags Class below "
  27.      ^ <primitive 209 2 5 attrTag private storageObj>
  28. |
  29.    getAmigaGuideMsg
  30.      " Returns nil if there was no message: "
  31.      ^ <primitive 209 2 6 private>
  32. |
  33.    getAGMsgType: aGuideMsgObj
  34.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  35.      ^ <primitive 209 2 31 aGuideMsgObj>
  36. |
  37.    getAGMsgData: aGuideMsgObj
  38.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  39.      ^ <primitive 209 2 32 aGuideMsgObj>
  40. |
  41.    getAGMsgDataType: aGuideMsgObj
  42.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  43.      ^ <primitive 209 2 33 aGuideMsgObj>
  44. |
  45.    getAGMsgDataSize: aGuideMsgObj
  46.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  47.      ^ <primitive 209 2 34 aGuideMsgObj>
  48. |
  49.    getAGMsgReturnPrimaryValue: aGuideMsgObj
  50.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  51.      ^ <primitive 209 2 35 aGuideMsgObj>
  52. |
  53.    getAGMsgReturnSecondaryValue: aGuideMsgObj
  54.      " aGuideMsgObj is from getAmigaGuideMsg method: "
  55.      ^ <primitive 209 2 36 aGuideMsgObj>
  56. |
  57.    getAmigaGuideString: stringIDNumber
  58.      " Returns a String Object or nil: "
  59.      ^ <primitive 209 2 7 stringIDNumber>
  60. |
  61.    lockAmigaGuideBase  " You DO NOT need to use this method!! "
  62.      " Returns a key for unlockAmigaGuideBase: "
  63.      ^ <primitive 209 2 8 private>
  64. |
  65.    unlockAmigaGuideBase: keyFromLockMethod   " You DO NOT need to use this method!! "
  66.      <primitive 209 2 9 keyFromLockMethod>
  67. |
  68.    openAmigaGuide: tagArray
  69.      " For valid tags, see AGuideTags Class below "
  70.      ^ private <- <primitive 209 2 1 private3 tagArray>
  71. |
  72.    openAmigaGuideASync: tagArray
  73.      " For valid tags, see AGuideTags Class below "
  74.      ^ private <- <primitive 209 2 10 private3 tagArray>
  75. |
  76.    replyAmigaGuideMsg: amigaGuideMsgObj
  77.      " Reply to the msg Object obtained from the getAmigaGuideMsg method: "
  78.      <primitive 209 2 11 amigaGuideMsgObj>
  79. |
  80.    sendAmigaGuideCommand: commandString tags: tagArray " tagArray should be nil for now. "
  81.      " The following are the currently valid action commands:
  82.      *
  83.      *   ALINK <name> - Load the named node into a new window.
  84.      *
  85.      *   LINK <name>  - Load the named node.
  86.      *
  87.      *   RX <macro>   - Execute an ARexx macro.
  88.      *
  89.      *   RXS <cmd> - Execute an ARexx string file.  To display a picture,
  90.      *               use 'ADDRESS COMMAND DISPLAY <picture name>', to
  91.      *               display a text file 'ADDRESS COMMAND MORE <doc>'.
  92.      *
  93.      *   CLOSE - Close the window (should only be used on windows
  94.      *           that were started with ALINK).
  95.      *
  96.      *   QUIT  - Shutdown the current database.
  97.      *
  98.      *   This method returns true if the message was sent:
  99.      "
  100.      ^ <primitive 209 2 12 private commandString tagArray>
  101. |
  102.    sendAmigaGuideContext: tagArray " tagArray should be nil for now. "
  103.      ^ <primitive 209 2 13 private tagArray> 
  104. |
  105.    setAmigaGuideAttributes: tagArray
  106.      " For valid tags, see AGuideTags Class below "
  107.      ^ <primitive 209 2 14 private tagArray>
  108. |
  109.    setAmigaGuideContext: idNumber tags: tagArray " tagArray should be nil for now. "
  110.      ^ <primitive 209 2 15 private idNumber tagArray>
  111. |
  112.    loadCrossReferencesFrom: fileName in: directoryLock
  113.      " Returns an integer with the following meanings:
  114.      *
  115.      *    -1 - indicates that the load was aborted by CTRL-C from the User.
  116.      *     0 - indicates failure to load.
  117.      *     1 - indicates a successful load.
  118.      *     2 - indicates that the table is already loaded.
  119.      "
  120.      ^ <primitive 209 2 18 directoryLock fileName>
  121. |
  122.    expungeCrossReferences " Unload the cross-reference table from memory. "
  123.      <primitive 209 2 19> 
  124. |
  125.    createNewAmigaGuideObject
  126.      ^ private3 <- <primitive 209 0 1 250>  " STRUCT_NewAmigaGuide = 250 "
  127. |
  128.    disposeNAG
  129.      <primitive 209 0 2 private3>.
  130.  
  131.      ^ private3 <- nil 
  132. |
  133.    setNAGDirectoryLock: directoryLock
  134.      <primitive 209 2 20 private3 directoryLock>     
  135. |
  136.    setNAGName: databaseName
  137.      <primitive 209 2 21 private3 databaseName>     
  138. |
  139.    setNAGScreen: screenObject
  140.      <primitive 209 2 22 private3 screenObject>
  141. |
  142.    setNAGPulicScreen: publicScreenName
  143.      <primitive 209 2 23 private3 publicScreenName>     
  144. |
  145.    setNAGARexxClientPort: clientPortName
  146.      <primitive 209 2 24 private3 clientPortName>
  147. |
  148.    setNAGFlags: newFlags
  149.      " Valid values for newFlags is any of the following:
  150.      *    HTF_LOAD_INDEX
  151.      *    This flag only applies to an ansynchronous open.
  152.      *    Force the index of the database to always be
  153.      *    loaded.  The AmigaGuide system maintains two date
  154.      *    stamps, one for the last time that the database was
  155.      *    opened and the other for the last time that the
  156.      *    database was accessed by the user. The hyper system
  157.      *    makes several calculations based on the current
  158.      *    date stamp and the other two date stamps to
  159.      *    determine what portions of the database need to be pre-cached.
  160.      *
  161.      *    HTF_LOAD_ALL
  162.      *    Load the entire database, and all its nodes into memory.
  163.      *
  164.      *    HTF_CACHE_NODE
  165.      *    Don't flush a node from memory after the user is finished viewing it.
  166.      *
  167.      *    HTF_CACHE_DB
  168.      *    Don't remove buffers when closed.  This will cause
  169.      *    the buffers to remain until the library is expunged.
  170.      " 
  171.      <primitive 209 2 25 private3 newFlags>     
  172. |
  173.    setNAGContextStrings: nodeStringsArray " Last element of Array MUST be nil! "
  174.      <primitive 209 2 26 private3 nodeStringsArray>     
  175. |
  176.    disposeContext 
  177.      " Use this after all 'setNAGContextStrings:' have been done (unless
  178.      * you have memory to burn!)
  179.      "
  180.      <primitive 209 2 30 private3>
  181. |
  182.    setNAGStartNode: nodeName
  183.      <primitive 209 2 27 private3 nodeName>
  184. |
  185.    setNAGStartLine: lineNumber
  186.      <primitive 209 2 28 private3 lineNumber>     
  187. |
  188.    setNAGTags: tagArray
  189.      " For valid tags, see AGuideTags Class below "
  190.      <primitive 209 2 29 private3 tagArray>     
  191. |
  192.    setNAGBaseName: appBaseName        " appBaseName can be nil "
  193.      <primitive 209 2 37 appBaseName>
  194. ]
  195.  
  196. " ------------------------------------------------------------------- "
  197. " AGuideTags Class is a Singleton class that allows the user to       "
  198. " reference special AmigaGuide Flags & Tags as #Symbols.              "
  199. ""
  200. " ALL singleton classes MUST contain the following:                   "
  201. ""
  202. "   the methods:  isSingleton AND privateSetup     AND                "
  203. "                 uniqueInstance Class instance variable.             "
  204. " ------------------------------------------------------------------- "
  205.  
  206. Class AGuideTags :Dictionary ! uniqueInstance !
  207. [
  208.    isSingleton
  209.      ^ true
  210. |
  211.    privateNew ! newinstance !
  212.      newinstance <- super new.
  213.  
  214.      ^ newinstance
  215. |
  216.    new
  217.      ^ self privateSetup
  218. |
  219.    privateInitializeDictionary
  220.  
  221.      self at: #StartupMsgID     put: 16r11001.  " Startup message         "
  222.      self at: #LoginToolID      put: 16r11002.  " Login a tool SIPC port  "
  223.      self at: #LogoutToolID     put: 16r11003.  " Logout a tool SIPC port "
  224.  
  225.      self at: #ShutdownMsgID    put: 16r11004.  " Shutdown message      "
  226.      self at: #ActivateToolID   put: 16r11005.  " Activate tool         "
  227.      self at: #DeactivateToolID put: 16r11006.  " Deactivate tool       "
  228.      self at: #ActiveToolID     put: 16r11007.  " Tool Active           "
  229.      self at: #InactiveToolID   put: 16r11008.  " Tool Inactive         "
  230.      self at: #ToolStatusID     put: 16r11009.  " Status message        "
  231.      self at: #ToolCmdID        put: 16r1100A.  " Tool command message  "
  232.      self at: #ToolCmdReplyID   put: 16r1100B.  " Reply to tool command "
  233.      self at: #ShutdownToolID   put: 16r1100C.  " Shutdown tool         "
  234.  
  235.      " Attributes accepted by getAmigaGuideAttribute:into: "
  236.  
  237.      self at: #AGA_Path         put: 16r80000001.
  238.      self at: #AGA_XRefList     put: 16r80000002.
  239.      self at: #AGA_Activate     put: 16r80000003.
  240.      self at: #AGA_Context      put: 16r80000004.
  241.      self at: #AGA_HelpGroup    put: 16r80000005. " Unique Integer identifier "
  242.      self at: #AGA_Reserved1    put: 16r80000006.
  243.      self at: #AGA_Reserved2    put: 16r80000007.
  244.      self at: #AGA_Reserved3    put: 16r80000008.
  245.  
  246.      " msgPortObject that is an ARexx message port: "
  247.  
  248.      self at: #AGA_ARexxPort     put: 16r80000009.
  249.  
  250.      " String used to specify the ARexx port name (not copied): "
  251.  
  252.      self at: #AGA_ARexxPortName put: 16r8000000A.
  253.  
  254.      self at: #AGA_Secure        put: 16r8000000B.
  255.  
  256.      " public Client flags (For setNAGFlags: method): "
  257.  
  258.      self at: #HTF_LOAD_INDEX  put: 1.  " Force load the index at init time "
  259.      self at: #HTF_LOAD_ALL    put: 2.  " Force load the entire database at init "
  260.      self at: #HTF_CACHE_NODE  put: 4.  " Cache each node as visited "
  261.      self at: #HTF_CACHE_DB    put: 8.  " Keep the buffers around until expunge "
  262.  
  263.      self at: #HTF_UNIQUE      put: 16r8000.  " Unique ARexx port name "
  264.      self at: #HTF_NOACTIVATE  put: 16r10000. " Don't activate window  "
  265.  
  266.      self at: #HTFC_SYSGADS    put: 16r80000000.
  267.  
  268.      " Callback function ID's "
  269.  
  270.      self at: #HTH_OPEN        put: 0.
  271.      self at: #HTH_CLOSE       put: 1.
  272.  
  273.      " Error message numbers: "
  274.  
  275.      self at: #HTERR_NOT_ENOUGH_MEMORY  put: 100.
  276.      self at: #HTERR_CANT_OPEN_DATABASE put: 101.
  277.      self at: #HTERR_CANT_FIND_NODE     put: 102.
  278.      self at: #HTERR_CANT_OPEN_NODE     put: 103.
  279.      self at: #HTERR_CANT_OPEN_WINDOW   put: 104.
  280.      self at: #HTERR_INVALID_COMMAND    put: 105.
  281.      self at: #HTERR_CANT_COMPLETE      put: 106.
  282.      self at: #HTERR_PORT_CLOSED        put: 107.
  283.      self at: #HTERR_CANT_CREATE_PORT   put: 108.
  284.      self at: #HTERR_KEYWORD_NOT_FOUND  put: 113.
  285.  
  286.      " Methods "
  287.  
  288.      self at: #HM_FINDNODE    put: 1.  " opFindHost "
  289.      self at: #HM_OPENNODE    put: 2.  " opNodeIO "
  290.      self at: #HM_CLOSENODE   put: 3.  " opNodeIO "
  291.      self at: #HM_EXPUNGE     put: 10. " Expunge DataBase  (opExpungeNode) "
  292.  
  293.      " onm_Flags (opNodeIO) "
  294.  
  295.      self at: #HTNF_KEEP      put: 1.  " Don't flush this node until database is closed "
  296.      self at: #HTNF_RESERVED1 put: 2.  " Reserved for system use "
  297.      self at: #HTNF_RESERVED2 put: 4.  " Reserved for system use "
  298.      self at: #HTNF_ASCII     put: 8.  " Node is straight ASCII "
  299.      self at: #HTNF_RESERVED3 put: 16. " Reserved for system use "
  300.      self at: #HTNF_CLEAN     put: 32. " Remove the node from the database "
  301.      self at: #HTNF_DONE      put: 64. " Done with node "
  302.  
  303.      " onm_Attrs (opNodeIO) "
  304.  
  305.      self at: #HTNA_Screen    put: 16r80000001. " screenObject that window resides in "
  306.      self at: #HTNA_Pens      put: 16r80000002. " Pen array (from DrawInfo) "
  307.      self at: #HTNA_Rectangle put: 16r80000003. " Window box                "
  308.      self at: #HTNA_HelpGroup put: 16r80000005. " unique Integer identifier "
  309.  
  310.      " Types of cross reference nodes "
  311.  
  312.      self at: #XR_GENERIC     put: 0.
  313.      self at: #XR_FUNCTION    put: 1.
  314.      self at: #XR_COMMAND     put: 2.
  315.      self at: #XR_INCLUDE     put: 3.
  316.      self at: #XR_MACRO       put: 4.
  317.      self at: #XR_STRUCT      put: 5.
  318.      self at: #XR_FIELD       put: 6.
  319.      self at: #XR_TYPEDEF     put: 7.
  320.      self at: #XR_DEFINE      put: 8.
  321. |
  322.    privateSetup
  323.      (uniqueInstance isNil)
  324.        ifTrue: [uniqueInstance <- self privateNew.
  325.  
  326.                 self privateInitializeDictionary
  327.                ].
  328.                
  329.      ^ self    "or ^ uniqueInstance??"
  330. ]